home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / soundu / dilaudid.zip / NEW / PLAY.BAS < prev    next >
BASIC Source File  |  1994-03-04  |  7KB  |  258 lines
  1. DECLARE FUNCTION getoct% (note$)
  2. DECLARE SUB doplay (dat%)
  3. DECLARE SUB d1 ()
  4. DECLARE SUB d2 ()
  5. DECLARE SUB playnote (note$, oct%)
  6. DECLARE SUB stopplay ()
  7. DECLARE SUB setoptions (am%, vibrato%, sustain%, harmonic%)
  8. DECLARE SUB setlevel (level%)
  9. DECLARE SUB setad (attack%, decay%)
  10. DECLARE SUB setsr (sustain%, release%)
  11. DECLARE SUB setwave (wavetype%)
  12. DECLARE SUB delay ()
  13. DEFINT A-Z
  14. COMMON SHARED curvoice, curoctave, curlength, deflength, curtempo
  15.  
  16. curtempo = 120
  17.  
  18. file$ = COMMAND$
  19. IF file$ = "" THEN
  20.         PRINT "play FILENAME"
  21.         END
  22. END IF
  23.  
  24. deflength = 16  'quarter note default
  25. curlength = 16
  26.  
  27. RANDOMIZE TIMER
  28. FOR curvoice = 0 TO 10
  29.     setoptions 0, 0, 1, 1
  30.     setlevel 63
  31.     setad 8, 1
  32.     setsr 2, 15
  33.     setwave curvoice MOD 4
  34.     stopplay
  35. NEXT
  36.  
  37.  
  38. curvoice = 0
  39. setlevel 20
  40.  
  41. CLS
  42.  
  43. OPEN file$ FOR INPUT AS #1
  44.  
  45. start& = TIMER
  46.  
  47. DO
  48.     LINE INPUT #1, x$
  49.     PRINT ">"; x$;
  50.     FOR curvoice = 0 TO 10
  51.         note$ = MID$(x$, (curvoice * 3) + 1, 3)
  52.         SELECT CASE note$
  53.             CASE "   "  'nothing
  54.             CASE "***"  'stop
  55.                 stopplay
  56.             CASE ELSE   'new note X: X" X' X x x' x" x: x; x= x*
  57.                 stopplay
  58.                 note$ = LTRIM$(RTRIM$(note$))
  59.                 oct = getoct(note$)
  60.                 playnote note$, oct
  61.         END SELECT
  62.     NEXT
  63.     PRINT
  64.     delay
  65. LOOP UNTIL EOF(1) OR INKEY$ <> ""
  66.  
  67. length& = TIMER - start&
  68.  
  69. PRINT "TIME: "; length& \ 60; ":"; length& MOD 60
  70.  
  71. FOR curvoice = 0 TO 10
  72.     setad 15, 15
  73. NEXT
  74.  
  75. CLOSE
  76.  
  77. PRINT "--Press any key--"
  78. DO UNTIL INKEY$ <> "": LOOP
  79.  
  80. SUB d1
  81.         FOR r = 1 TO 6: x = INP(&H388): NEXT
  82. END SUB
  83.  
  84. SUB d2
  85.         FOR r = 1 TO 35: x = INP(&H388): NEXT
  86. END SUB
  87.  
  88. SUB delay
  89.         x# = (1 / curlength) * (60 / curtempo)
  90.         xx# = TIMER + x#
  91.         DO UNTIL TIMER > xx#: LOOP
  92. END SUB
  93.  
  94. SUB doplay (dat)
  95.         curvoice = 0
  96.         curlength = 8
  97.         curoctave = dat \ 25
  98.         x$ = "defgabccccc"
  99.         n$ = MID$(x$, ((dat MOD 25) \ 4) + 1, 1)
  100.         stopplay
  101.         playnote n$, curoctave
  102.         PRINT n$ + "/o" + LTRIM$(RTRIM$(STR$(curoctave))) + " ";
  103.         delay
  104.  
  105. END SUB
  106.  
  107. FUNCTION getoct (note$)
  108.     ' X" X' X x x' x" x: x; x= x*
  109.     no = 1
  110.     IF ASC(MID$(note$, 1, 1)) < 72 THEN 'ucase
  111.         SELECT CASE RIGHT$(note$, 1)
  112.             CASE ":"
  113.                 oct = 0
  114.             CASE CHR$(34)
  115.                 oct = 1
  116.             CASE "'"
  117.                 oct = 2
  118.             CASE ELSE
  119.                 oct = 3
  120.                 no = 0
  121.         END SELECT
  122.     ELSE
  123.         SELECT CASE RIGHT$(note$, 1)
  124.             CASE "'"
  125.                 oct = 5
  126.             CASE CHR$(34)
  127.                 oct = 6
  128.             CASE ":"
  129.                 oct = 7
  130.             CASE ";"
  131.                 oct = 8
  132.             CASE "="
  133.                 oct = 9
  134.             CASE "*"
  135.                 oct = 10
  136.             CASE ELSE
  137.                 oct = 4
  138.                 no = 0
  139.         END SELECT
  140.     END IF
  141.     IF no = 1 THEN note$ = MID$(note$, 1, LEN(note$) - 1)
  142.     getoct = oct
  143. END FUNCTION
  144.  
  145. SUB playnote (note$, oct)
  146. SELECT CASE LCASE$(note$)
  147.         CASE "c#", "c+", "d-"
  148.                 msb = &H1: lsb = &H6B
  149.         CASE "d"
  150.                 msb = &H1: lsb = &H81
  151.         CASE "d#", "d+", "e-"
  152.                 msb = &H1: lsb = &H98
  153.         CASE "e"
  154.                 msb = &H1: lsb = &HB0
  155.         CASE "f"
  156.                 msb = &H1: lsb = &HCA
  157.         CASE "f#", "f+", "g-"
  158.                 msb = &H1: lsb = &HE5
  159.         CASE "g"
  160.                 msb = &H2: lsb = &H2
  161.         CASE "g#", "g+", "a-"
  162.                 msb = &H2: lsb = &H20
  163.         CASE "a"
  164.                 msb = &H2: lsb = &H41
  165.         CASE "a#", "a+", "b-"
  166.                 msb = &H2: lsb = &H63
  167.         CASE "b"
  168.                 msb = &H2: lsb = &H87
  169.         CASE "c"
  170.                 msb = &H2: lsb = &HAE
  171.                 oct = oct - 1
  172.         CASE ELSE
  173.                 PRINT "ERR[" + note$ + "]";
  174. END SELECT
  175.  
  176.         OUT &H388, &HA0 + curvoice: d1
  177.         OUT &H389, lsb: d2
  178.         OUT &H388, &HA3 + curvoice: d1
  179.         OUT &H389, lsb: d2
  180.  
  181.         OUT &H388, &HB0 + curvoice: d1
  182.         OUT &H389, msb + (oct * 4) + 32: d2
  183.         OUT &H388, &HB3 + curvoice: d1
  184.         OUT &H389, msb + (oct * 4) + 32: d2
  185.  
  186. END SUB
  187.  
  188. SUB setad (attack, decay)
  189.         OUT &H388, &H60 + curvoice: d1
  190.         OUT &H389, (attack * 16) + decay: d2
  191.         OUT &H388, &H63 + curvoice: d1
  192.         OUT &H389, (attack * 16) + decay: d2
  193. END SUB
  194.  
  195. SUB setlevel (level)
  196.         OUT &H388, &H40 + curvoice: d1
  197.         OUT &H389, (63 - level): d2
  198.         OUT &H388, &H43 + curvoice: d1
  199.         OUT &H389, (63 - level): d2
  200. END SUB
  201.  
  202. SUB setoptions (am, vibrato, sustain, harmonic)
  203.         temp = 0
  204.         IF am THEN temp = 128
  205.         IF vibrato THEN temp = temp + 64
  206.         IF sustain THEN temp = temp + 32
  207.         '       harmonic options:
  208.         '            0 - one octave below
  209.         '            1 - at the voice's specified frequency
  210.         '            2 - one octave above
  211.         '            3 - an octave and a fifth above
  212.         '            4 - two octaves above
  213.         '            5 - two octaves and a major third above
  214.         '            6 - two octaves and a fifth above
  215.         '            7 - two octaves and a minor seventh above
  216.         '            8 - three octaves above
  217.         '            9 - three octaves and a major second above
  218.         '           10 - three octaves and a major third above
  219.         '           11 -  "       "     "  "   "     "     "
  220.         '           12 - three octaves and a fifth above
  221.         '           13 -   "      "     "  "   "     "
  222.         '           14 - three octaves and a major seventh above
  223.         '           15 -   "      "     "  "   "      "      "
  224.         temp = temp + harmonic
  225.         OUT &H388, &H20 + curvoice: d1
  226.         OUT &H389, temp: d2
  227.         OUT &H388, &H23 + curvoice: d1
  228.         OUT &H389, temp: d2
  229. END SUB
  230.  
  231. SUB setsr (sustain, release)
  232.         OUT &H388, &H80 + curvoice: d1
  233.         OUT &H389, ((15 - sustain) * 16) + release: d2
  234.         OUT &H388, &H83 + curvoice: d1
  235.         OUT &H389, ((15 - sustain) * 16) + release: d2
  236. END SUB
  237.  
  238. SUB setwave (wavetype)
  239.         OUT &H388, &HE0 + curvoice: d1
  240.         '   ___              ___            ___    ___       _      _
  241.         '  /   \            /   \          /   \  /   \     / |    / |
  242.         ' /_____\_______   /_____\_____   /_____\/_____\   /__|___/__|___
  243.         '        \     /
  244.         '         \___/
  245.         '     -0-             -1-              -2-             -3-
  246.         OUT &H389, wavetype: d2
  247.         OUT &H388, &HE3 + curvoice: d1
  248.         OUT &H389, wavetype: d2
  249. END SUB
  250.  
  251. SUB stopplay
  252.         OUT &H388, &HB0 + curvoice: d1
  253.         OUT &H389, 0: d2
  254.         OUT &H388, &HB3 + curvoice: d1
  255.         OUT &H389, 0: d2
  256. END SUB
  257.  
  258.